perm filename BNFER[BNF,JRA] blob sn#001939 filedate 1972-10-06 generic text, type T, neo UTF8
(SETQ IBASE (ADD1 7)) 


(DEFPROP BNFER 
 (NIL INBNF
      RDBNF
      OUTBNF
      <RULES>
      <RULE>
      <RTLST>
      <RTPT>
      <LFPT>
      <RPELEM>
      <SEXPR>
      <SEXPRLIST>
      >RULES<
      >RULE<
      >RTLST<
      >LFPT<
      >RTPT<
      >RPELEM<
      >SEXPR<
      >SEXPRLIST<) 
VALUE)

(DEFPROP INBNF 
 (LAMBDA NIL
  (PROG NIL
	(COND
	 ((NULL (RDBNF)) (INC NIL T)
			 (PRINC (QUOTE "
YOUR BNF LOSES AT (PAGE . LINE) = "))
			 (PRIN1 (PGLINE))
			 (RETURN NIL)))
	(SETQ RULES (TOP))
	(PRODUCE RULES)
	(SETQ LANG (APPEND <LANG> >LANG<))
	(RETURN (QUOTE OK)))) 
EXPR)

(DEFPROP RDBNF 
 (LAMBDA NIL (PROG (X) (START) (SCANSET) (INC T) (SETQ X (<RULES>)) (SCANRESET) (RETURN X))) 
EXPR)

(DEFPROP OUTBNF 
 (LAMBDA NIL (PROG NIL (SETQ &&Z (FUNFLAT (OUTTST RULES (QUOTE >RULES<)))) (OTST 140))) 
EXPR)

(DEFPROP <RULES> 
 (LAMBDA NIL
  (NLRR (QUOTE RULES)
	(FUNCTION
	 (LAMBDA NIL
	  (COND ((AND (SPWD END)) NIL) ((AND (<RULE>) (<RULES>)) (CONS (STK 1) (STK 0))) (*NIL*)))))) 
EXPR)

(DEFPROP <RULE> 
 (LAMBDA NIL
  (NLRR (QUOTE RULE)
	(FUNCTION (LAMBDA NIL (COND ((AND (<LFPT>) (<RTLST>)) (CONS (STK 1) (CONS (STK 0) NIL))) (*NIL*)))))) 
EXPR)

(DEFPROP <RTLST> 
 (LAMBDA NIL
  (NLRR (QUOTE RTLST)
	(FUNCTION
	 (LAMBDA NIL
	  (COND ((AND (CH :) (CH :) (CH =) (<RTPT>) (<SEXPR>) (<RTLST>))
		 (CONS (CONS (STK 2) (CONS (STK 1) NIL)) (STK 0)))
		((AND) NIL)
		(*NIL*)))))) 
EXPR)

(DEFPROP <RTPT> 
 (LAMBDA NIL
  (NLRR (QUOTE RTPT)
	(FUNCTION
	 (LAMBDA NIL
	  (COND ((AND (QCH =) (CH >)) NIL) ((AND (<RPELEM>) (<RTPT>)) (CONS (STK 1) (STK 0))) (*NIL*)))))) 
EXPR)

(DEFPROP <LFPT> 
 (LAMBDA NIL (NLRR (QUOTE LFPT) (FUNCTION (LAMBDA NIL (COND ((AND (CH <) (<ID>) (CH >)) (STK 1)) (*NIL*)))))) 
EXPR)

(DEFPROP <RPELEM> 
 (LAMBDA NIL
  (NLRR (QUOTE RPELEM)
	(FUNCTION
	 (LAMBDA NIL
	  (COND ((AND (CH <) (<ID>) (CH >)) (STK 1))
		((AND (QCH ↓)) (CONS (QUOTE FORMAT) (CONS (QUOTE %DOWN) NIL)))
		((AND (QCH →) (<NUMBER>))
		 (CONS (QUOTE FORMAT) (CONS (CONS (QUOTE %IN) (CONS (STK 0) NIL)) NIL)))
		((AND (QCH →)) (CONS (QUOTE FORMAT) (CONS (CONS (QUOTE %IN) (CONS (QUOTE 0) NIL)) NIL)))
		((AND (<ID>)) (CONS (QUOTE SPWD) (CONS (STK 0) NIL)))
		((AND (QCH /") (<CHAR>)) (CONS (QUOTE QCH) (CONS (STK 0) NIL)))
		((AND (<CHAR>)) (CONS (QUOTE CH) (CONS (STK 0) NIL)))
		(*NIL*)))))) 
EXPR)

(DEFPROP <SEXPR> 
 (LAMBDA NIL
  (NLRR (QUOTE SEXPR)
	(FUNCTION
	 (LAMBDA NIL (COND ((AND (<ATOM>)) (STK 0)) ((AND (CH /() (<SEXPRLIST>) (CH /))) (STK 1)) (*NIL*)))))) 
EXPR)

(DEFPROP <SEXPRLIST> 
 (LAMBDA NIL
  (NLRR (QUOTE SEXPRLIST)
	(FUNCTION
	 (LAMBDA NIL
	  (COND ((AND (<SEXPR>) (<SEXPRLIST>)) (CONS (STK 1) (STK 0)))
		((AND (CH /.) (<ATOM>)) (STK 0))
		((AND) NIL)
		(*NIL*)))))) 
EXPR)

(DEFPROP >RULES< 
 (LAMBDA(%N)
  (OUTRUL %N
	  (FUNCTION
	   (LAMBDA NIL
	    (COND ((EQ (QUOTE NIL) (STK1)) (LIST (QUOTE (%IN 0)) (QUOTE END)))
		  ((AND (MATCH (QUOTE (* . *))) (>RULE< 1) (>RULES< 0))
		   (LIST (STK1) (QUOTE (%IN 0)) (STK0)))))))) 
EXPR)

(DEFPROP >RULE< 
 (LAMBDA(%N)
  (OUTRUL %N
	  (FUNCTION
	   (LAMBDA NIL (COND ((AND (MATCH (QUOTE (* *))) (>LFPT< 1) (>RTLST< 0)) (LIST (STK1) (STK0)))))))) 
EXPR)

(DEFPROP >RTLST< 
 (LAMBDA(%N)
  (OUTRUL %N
	  (FUNCTION
	   (LAMBDA NIL
	    (COND ((EQ (QUOTE NIL) (STK1)) FOOBAZ)
		  ((AND (MATCH (QUOTE ((* *) . *))) (>RTPT< 2) (>SEXPR< 1) (>RTLST< 0))
		   (LIST (QUOTE (%IN 10))
			 (QUOTE (:CH :))
			 (QUOTE (:CH :))
			 (QUOTE (:CH =))
			 (STK2)
			 (STK1)
			 (QUOTE (%IN 0))
			 (STK0)))))))) 
EXPR)

(DEFPROP >LFPT< 
 (LAMBDA(%N)
  (OUTRUL %N (FUNCTION (LAMBDA NIL (COND ((>ID< 1) (LIST (QUOTE (:CH <)) (STK1) (QUOTE (:CH >))))))))) 
EXPR)

(DEFPROP >RTPT< 
 (LAMBDA(%N)
  (OUTRUL %N
	  (FUNCTION
	   (LAMBDA NIL
	    (COND ((EQ (QUOTE NIL) (STK1)) (LIST (QUOTE (%IN 60)) (QUOTE (:CH =)) (QUOTE (:CH >))))
		  ((AND (MATCH (QUOTE (* . *))) (>RPELEM< 1) (>RTPT< 0)) (LIST (STK1) (STK0)))))))) 
EXPR)

(DEFPROP >RPELEM< 
 (LAMBDA(%N)
  (OUTRUL %N
	  (FUNCTION
	   (LAMBDA NIL
	    (COND ((AND (MATCH (QUOTE (FORMAT %DOWN)))) (QUOTE (:CH ↓)))
		  ((AND (MATCH (QUOTE (FORMAT (%IN 0))))) (QUOTE (:CH →)))
		  ((AND (MATCH (QUOTE (SPWD *))) (>ID< 0)) (STK0))
		  ((AND (MATCH (QUOTE (QCH *))) (>CHAR< 0)) (LIST (QUOTE (:CH /")) (STK0)))
		  ((AND (MATCH (QUOTE (CH *))) (>CHAR< 0)) (STK0))
		  ((AND (MATCH (QUOTE (FORMAT (%IN *)))) (>NUMBER< 0)) (LIST (QUOTE (:CH →)) (STK0)))
		  ((>ID< 1) (LIST (QUOTE (:CH <)) (STK1) (QUOTE (:CH >))))))))) 
EXPR)

(DEFPROP >SEXPR< 
 (LAMBDA(%N)
  (OUTRUL %N
	  (FUNCTION
	   (LAMBDA NIL
	    (COND ((>ATOM< 1) (STK1))
		  ((>SEXPRLIST< 1) (LIST (QUOTE (:CH /()) (QUOTE %DOWN) (STK1) (QUOTE (:CH /)))))))))) 
EXPR)

(DEFPROP >SEXPRLIST< 
 (LAMBDA(%N)
  (OUTRUL %N
	  (FUNCTION
	   (LAMBDA NIL
	    (COND ((EQ (QUOTE NIL) (STK1)) FOOBAZ)
		  ((AND (MATCH (QUOTE (* . *))) (>SEXPR< 1) (>SEXPRLIST< 0))
		   (LIST (QUOTE (%IN 0)) (STK1) (STK0)))
		  ((>ATOM< 1) (LIST (QUOTE (%IN 0)) (QUOTE (:CH /.)) (STK1)))))))) 
EXPR)